## Warning: package 'rmarkdown' was built under R version 3.5.2
Â
Date: 2019-12-12
R version: 3.5.0
*Corresponding author: matthew.malishev@gmail.com
This document can be found at https://github.com/darwinanddavis/UsefulCode
Same deal as Useful Code, but the second instalment because the first one has too much stuff in it and now runs slow.
Colorspace
require(colorspace)
hcl_palettes(plot = TRUE) # show all palettes# https://cran.r-project.org/web/packages/colorspace/vignettes/colorspace.html
require(colorspace)
q4 <- qualitative_hcl(4, palette = "Dark 3") # discrete
s9 <- sequential_hcl(9, "Purples 3") # continuous
# for ggplot
scale_color_discrete_sequential(palette = "Purples 3", nmax = 6, order = 2:6)
# for colospace functions: hcl_palettes() %>% str hcl_palettes()['type']Neon colour palettes
# https://www.shutterstock.com/blog/neon-color-palettes
neon1 <- c("#3B27BA", "#FF61BE", "#13CA91", "#FF9472")
neon2 <- c("#FFDEF3", "#FF61BE", "#3B55CE", "#35212A")
neon3 <- c("#FEA0FE", "#F85125", "#02B8A2", "#535EEB")
neon4 <- c("#535EEB", "#001437", "#C6BDEA", "#FFAA01")
scales::show_col(c(neon1, neon2, neon3, neon4))D3 and leaflet
devtools::install_github("jcheng5/d3scatter")
require(pacman)
p_load(d3scatter, crosstalk, leaflet, tibble, httpuv)
sd <- SharedData$new(quakes[sample(nrow(quakes), 100), ])
bscols(widths = c(12, 6, 6), filter_slider("stations", "Stations", sd, ~stations), leaflet(sd, width = "100%",
height = 400) %>% addTiles() %>% addCircleMarkers(lng = sd$data()[, "long"], lat = sd$data()[, "lat"],
stroke = F, fill = T, color = "red", fillOpacity = 0.5, radius = ~mag + 2, label = ~paste0("Depth: ",
as.character(depth))), d3scatter(sd, width = "100%", height = 400, ~mag, ~depth, color = ~stations))Reversing order of rows in dataframe
# df = data.frame
require(tidyverse)
df %>% map_df(rev)dplyr basicsrequire(dplyr, gapminder)
p_load(gapminder)
# mutate
africa_ranked <- mutate(gapminder, African = continent == "Africa", RankPop = rank(desc(pop)))
africa_ranked %>% glimpse() # visualise the data
africa_ranked %>% filter(continent == "Africa") %>% glimpse # visualise just africa
# summarise data into one line
gapminder %>% summarise(MinYear = min(year, na.rm = T), MaxYear = max(year), CountryCount = n_distinct(country),
Counts = n())
gapminder %>% summarise(median(lifeExp))
# filter
require(gapminder)
gapminder %>% filter(continent == "Africa")
# group by
gapminder %>% group_by(continent) %>% summarise(median(lifeExp))
# group by continent and filter by year
life_cont_1992 <- gapminder %>% group_by(Continent = continent) %>% filter(year == 1992) %>% summarise(LifeExpect = median(lifeExp))Clickme, NVD3, Polychart, rCharts, Rickshaw, and xCharts in R.
Link to collated Github page.
Transpose list (flip list elements)
l <- list(1:2, 3:4, 5:7, 8:10)
l
b <- data.table::transpose(l)
blengths for getting length of list indices
require(dplyr)
ls = list(rep(list(sample(50, replace = T)), 5))
ls %>% length
ls %>% lengths
lapply(ls, lengths)Split list into smaller sublists
la = rep(list(1:5), 6)
names(la) = rep(LETTERS[1:3], 2)
u <- length(unique(names(la)))
n <- length(la)/u
split(la, rep(1:n, each = u))
# for when list has two elements in the name that change create a list of 10 letters with 5 lists in
# each
big_list <- rep(list(1:10), 5) %>% pmap(list)
names(big_list) <- LETTERS[1:10]
# to index the upper list
big_list["B"] # 1
pluck(big_list, "B") # 2
# to index the sublists
map(big_list["B"], 3) # 1
bb_final <- list() # 2
for (i in 1:10) {
bb <- big_list["B"]
bb_final <- c(bb_final, bb)
}
bb_finalFill list elements with NAs to match length of longest element
# https://stackoverflow.com/questions/34570860/add-nas-to-make-all-list-elements-equal-length
# for single index list
set.seed(1)
ls = replicate(5, sample(1:100, 10), simplify = FALSE)
names(ls) = LETTERS[1:length(ls)]
lapply(ls, `length<-`, max(lengths(ls)))
# for sublists
ls = list(replicate(5, sample(1:100, 10), simplify = FALSE))
n.ticks = 20
fillvec = function(x) {
nv = lapply(x, `length<-`, n.ticks) # fill remaining vec with NAs to match total length
rapply(nv, f = function(x) ifelse(is.na(x), 0, x), how = "replace") # replace NAs with 0s
}
lapply(ls, fillvec) # apply fillvec to listAccess list elements in loop by name/string
set.seed(12)
# inputs
time <- 5
time_vec <- 1:10
a_vec <- runif(10)
beta1_vec <- 1:10
beta2_vec <- 11:20
param_vec <- list(a_vec,beta1_vec,beta2_vec)
names(param_vec) <-c("alpha","beta1","beta2")
params <- sapply(rep(NA,length(param_vec)),list) # create empty final params vector
names(params) <- names(param_vec)
# select parameter to test
param_input <- "alpha" #beta1 #beta2
# run from here -----------------------------------------------------------
for(time in time_vec) {
p_in = param_vec[`param_input`][[1]][time] # get parameter value by name
# create new list of with updated param_input value
params <- c(param_vec[-which(names(param_vec)==param_input)], # everything but param_input
param_input = p_in # param_input
)
# get just the latest value
# remove this if you want all list elements
params <- sapply(params,function(x) x[1]) %>% as.numeric
# rename this new list
names(params) <- c(names(param_vec)[-which(names(param_vec)==param_input)], # everything but param_input
param_input
)
print(params)
} # end loop
params # each list element changes depending on user input Apply function to nested lists
ls = list(replicate(5, sample(1:100, 10), simplify = FALSE))
ls %>% glimpse
lapply(ls, lapply, mean)
lapply(ls, sapply, mean) # return as one list
rapply(ls, mean, how = "unlist") # unlist, replace, or listpacman
require(pacman)
p_load(dplyr, mapdeck)Read in csv data sources directly from web
# link to raw csv link on e.g. github
require(readr)
url <- "https://raw.githubusercontent.com/plotly/datasets/master/2011_february_aa_flight_paths.csv"
flights <- read_csv(url)resource_type <- "algae"
# this regex expression
list.files(pattern = paste0("^", resource_type, "_[0,5]{1}_[0-9]{1,2}_hostpop50_predpop", "[0-9]{1,3}_rep[1-5]{1}\\.R$"))
# returns this begins with resource_type, either 0 or 5 as one integer, 0 to 9 as either one or two
# integers, 0 to 9 as one to three integers, and 1 to 5 as one integer
"algae_0_5_hostpop50_predpop5_rep1.R"
"algae_5_20_hostpop50_predpop30_rep2.R"
"algae_0_15_hostpop50_predpop150_rep5.R"RmarkdownSplit page into three columns (displays best in browser).
R code is in Rmd file.
# r plot code
require(ggplot2)
ggplot(mtcars, aes(x = mpg)) + geom_histogram(fill = "skyblue", alpha = 0.5) + theme_classic()Praise the lord, I was born to travel
Feeling like Slash in front of the chapel
I’m leaned back with the Les Paul
Shit I smoke is like cholesterol
Spilled dressin’ on the vest at the festival
The best of all, had a midget Puerto Rican at my beckon call
Pump the bass in the trunk
It rattled like a baby hand
Except this toy cost 80 grand
And I’m crazy tan, from all the places that I’ve been
Just from writing words with a pen
plotlyHTML widget with plotly and crosstalk
require(pacman)
p_load(plotly, tidyr, crosstalk)
m <- gather(mpg, variable, value, -c(year, cyl))
msd <- highlight_key(m, ~variable)
gg <- ggplot(m, aes(factor(year), value)) + geom_jitter(alpha = 0.3) + labs(x = "Year") + theme_classic()
bscols(widths = c(11, rep(5, 2)), filter_select("id", "Select a variable", msd, ~variable, multiple = F),
ggplotly(gg, dynamicTicks = "y") %>% layout(margin = list(l = 30)), plot_ly(msd, x = ~jitter(cyl),
y = ~value, alpha = ~cyl, linetype = NULL, mode = "markers", hoverinfo = "text", text = ~paste0("Cyl: ",
round(cyl), "\n", variable, ": ", value, "\nYear: ", year)) %>% add_markers(alpha = 0.3) %>%
layout(xaxis = list(showgrid = F, title = "Cylinder"), yaxis = list(showgrid = F)))